﻿
{*******************************************************}
{                                                       }
{       DelphiWebMVC 5.0                                }
{       E-Mail:pearroom@yeah.net                        }
{       版权所有 (C) 2022-2 苏兴迎(PRSoft)              }
{                                                       }
{*******************************************************}
unit MVC.Route;
{$I mvc.inc}

interface

uses
  System.SysUtils, System.DateUtils, System.Classes, System.StrUtils,
  MVC.Session, System.Generics.Collections, system.TypInfo, System.Rtti,
  MVC.Config, IdURI, MVC.Controller, MVC.LogUnit, MVC.HttpMmt, MVC.TplUnit,
  MVC.Tool, mvc.TplParser, mvc.JSON, mvc.DataSet, REST.Json;

type
  TRouteItem = class
  private
    MethodList: TStringList;
    HttpMethod: TStringList;
    locMethodList: TStringList;
    FPath: string;
    FName: string;
    FAction: TClass;
    FMethodPath: string;
    FTableName: string;

    procedure SetAction(const Value: TClass);
    procedure SetName(const Value: string);
    procedure SetPath(const Value: string);
    procedure SetMethodPath(const Value: string);
    procedure SetTableName(const Value: string);
  public
    ActoinClass: TRttiType;
    CreateController, Intercept, Show, InputToJson, InputJSON: TRttiMethod;
    Response, Request, routeUrl_pro, tplPath_pro, MethodName_pro, TableName_pro: TRttiProperty;
    property routeUrl: string read FName write SetName;
    property MethodPath: string read FMethodPath write SetMethodPath;
    property Action: TClass read FAction write SetAction;
    property tplPath: string read FPath write SetPath;
    property TableName: string read FTableName write SetTableName;

    function ActionMethod(methodname: string): TRttiMethod;
    function getMethod(httpMethod: string; methodname: string): string;
    function getMethodTpl(methodname: string): string;
    function getMethodType(methodname: string): string;
    constructor Create();
    destructor Destroy; override;
  end;

  TRoute = class
  private
    _RTTIContext: TRttiContext;
    list: TObjectList<TRouteItem>;
    listkey: TStringList;
    function GetItem(Route: string): TRouteItem;
    function finditem(name: string): Boolean;
    function DateTimeToGMT(const ADate: TDateTime): string;
    procedure loadAssets(_Request: TWebRequest; _Response: TWebResponse; url: string);
    function getMimeType(extension: string): string;
    function StrToParamTypeValue(AValue: string; AParamType: System.TTypeKind): TValue;
    procedure ClearP(ls: TStringList);
    procedure FreeValueArray(aValueArray: TArray<TValue>);

  public
    ApiDoc: string;
    procedure SetRoute(routeUrl: string; Action: TClass; tplPath: string; rqUrl: string; locUrl: string; httpMethod: string; tablename_: string);
    function GetRoute(httpMethod: string; url: string; var Route: string; var method: string): TRouteItem;
    procedure Error500(Response: TWebResponse; msg: string = '');
    procedure Error404(Response: TWebResponse; msg: string);
    function GetUrlParams(action: TObject; methodname: string; url: string; Request: TWebRequest; Response: TWebResponse; item: TRouteItem; ActionMethod: TRttiMethod): TArray<TValue>;
    function GetTick(classname: string; _Request: TWebRequest; var msg: string): Cardinal;
    function GetTickCount: Cardinal;
    constructor Create(); virtual;
    destructor Destroy; override;
  end;

var
  RouteMap: TRoute;
  _RTTIContext: TRttiContext;

procedure initRoute;

procedure OpenRoute(_Request: TWebRequest; _Response: TWebResponse);

implementation
{ TRoute }

procedure initRoute;
var
  ms: TArray<TRttiMethod>;
  tts: TArray<TRttiType>;
  tmpMethod: TRttiMethod;
  lMethod, sRouteUrl, mRouteUrl, sTplPath, s, sHttpMethod, stablename: string;
  tt: TRttiType;
  cl: TClass;
  AttrMethod, AttrClass: TCustomAttribute;
  remarks: string;
begin
  tts := _RTTIContext.GetTypes;
  for tt in tts do
  begin
    begin
      if (tt.Handle.Kind = System.TTypeKind.tkClass) then
      begin

        cl := tt.Handle.TypeData.ClassType;

        if (cl.InheritsFrom(TController)) then
        begin
          s := cl.ClassName;
          for AttrClass in tt.GetAttributes do
          begin
            if AttrClass is TMURL then
            begin
              with TMURL(AttrClass) do
              begin
                sRouteUrl := routeUrl;
                sTplPath := tplPath;

              end;
            end;
            if AttrClass is TTable then
            begin
              with TTable(AttrClass) do
              begin
                stablename:=FTableName;
              end;
            end;

          end;
          RouteMap.setRoute(sRouteUrl, cl, sTplPath, '', '', '',stablename);
          ms := tt.GetMethods;

          for tmpMethod in ms do
          begin
            var s1:=tmpMethod.Name;
            var isok := false;
            for AttrMethod in tmpMethod.GetAttributes do
            begin
              if AttrMethod is TMURL then
              begin
                with TMURL(AttrMethod) do
                begin
                  mRouteUrl := routeUrl;
                  lMethod := tmpMethod.Name;
                  sHttpMethod := getMethodType;
                  RouteMap.setRoute(sRouteUrl, cl, sTplPath, mRouteUrl, lMethod, sHttpMethod,stablename);
                  isok := true;
                end;
              end

            end;
            if not isok then
            begin
              RouteMap.setRoute(sRouteUrl, cl, sTplPath, tmpMethod.Name, tmpMethod.Name, '',stablename);
            end;
          end;
        end;
      end;
    end;
  end;
  if remarks <> '' then
  begin
    remarks := remarks.Substring(0, remarks.Length - 1);
  end;
  remarks := '[' + remarks + ']';
  RouteMap.ApiDoc := remarks;
end;

function LoadFile(_Response: TWebResponse; url: string): boolean;
var
  filepath: string;
  pagepars: TTplParser;
  htmlcontent: string;
begin
  filepath := Config.BasePath + Config.WebRoot + '\' + Config.template + url + Config.template_type;
  filepath := IITool.PathFmt(filepath);
  htmlcontent := PageCache.LoadPage(filepath);

  if htmlcontent <> '' then
  begin
    pagepars := TTplParser.Create;
    try
      pagepars.Parser(htmlcontent, nil, '');
    finally
      pagepars.Free;
    end;
    _Response.ContentType := 'text/html; charset=' + Config.document_charset;
    _Response.Content := htmlcontent;
    _Response.SendResponse;
    Result := true;
  end
  else
  begin
    Result := false;
  end;
end;

procedure Corss_Origin(Response: TWebResponse);
var
  s: string;
begin
  s := Config.Corss_Origin.Allow_Origin;
  if s <> '' then
  begin
    Response.SetCustomHeader('Access-Control-Allow-Origin', s);
    s := Config.Corss_Origin.Allow_Headers;
    if s <> '' then
      Response.SetCustomHeader('Access-Control-Allow-Headers', s);
    s := Config.Corss_Origin.Allow_Method;
    if s <> '' then
      Response.SetCustomHeader('Access-Control-Allow-Methods', s);
    if Config.Corss_Origin.Allow_Credentials then
      Response.SetCustomHeader('Access-Control-Allow-Credentials', 'true')
    else
      Response.SetCustomHeader('Access-Control-Allow-Credentials', 'false');
  end;
end;

procedure OpenRoute(_Request: TWebRequest; _Response: TWebResponse);
var
  Action: TObject;
 // Attribute: TCustomAttribute;
  ActionMethod, Intercept, CreateControllerMethod, Show: TRttiMethod;
  Response, Request, tplPath, RouteUrl, MethodName_, TableName_: TRttiProperty;
  url, RoutePath, assetsfile: string;
  item: TRouteItem;
  k: Integer;
  methodname, httpMethod: string;
  ret_Intercept: TValue;
  InterceptRet: boolean;
  aValueArray: TArray<TValue>;
 // iTickCount: Cardinal;
  len: Integer;
  resValue: TValue;
  ValueType: string[255];
  typeInfo: PTypeInfo;
  interface_type: IInterface;
  jo: IJObject;
  ja: IJArray;
  ds: IDataSet;
  resText: string;
  resdata: TResData;
//  logmsg: string;
  extension: string;
begin
  InterceptRet := false;
  _Response.ContentEncoding := Config.document_charset;
  _Response.Date := Now;
  httpMethod := _Request.Method;
  url := _Request.PathInfo;
  url := IITool.UrlFmt(url);
  _Response.StatusCode := 200;
  if (pos('__doc__', url) > 0) and (config.APIDoc) then
  begin
    _Response.ContentType := 'application/json; charset=' + Config.document_charset;
    _Response.Content := RouteMap.ApiDoc;
    _Response.SendResponse;
    exit;
  end;
  Corss_Origin(_Response);
  if httpMethod = 'OPTIONS' then
  begin
    _Response.StatusCode := 200;
    _Response.SendResponse;
    exit;
  end;
  if Config.App <> '' then
  begin
    url := url.Replace(Config.App, '');
    url := IITool.UrlFmt(url);
  end;

  assetsfile := Config.BasePath + Config.WebRoot + url;
  assetsfile := IITool.PathFmt(assetsfile);
  if (Config.suffix.Trim <> '') and (not FileExists(assetsfile)) then
  begin
    if RightStr(url, Length(Config.suffix)) = Config.suffix then
      url := url.Replace(Config.suffix, '');
  end;
  if not Config.check_directory_permission(url) then
  begin
    RouteMap.Error404(_Response, url);
    exit;
  end;
  extension := ExtractFileExt(assetsfile).Replace('.', '');
  extension := RouteMap.getMimeType(extension);
  if extension = '' then
  begin
    item := RouteMap.GetRoute(httpMethod, url, RoutePath, methodname);
    if item <> nil then
    begin
      Action := item.Action.Create;
      try
        Show := item.Show;
        Request := item.Request;
        Response := item.Response;
        tplPath := item.tplPath_pro;
        RouteUrl := item.routeUrl_pro;
        MethodName_ := item.MethodName_pro;
        TableName_ := item.TableName_pro;

        Intercept := item.Intercept;   //获取拦截方法
        CreateControllerMethod := item.CreateController;

        Request.SetValue(Action, _Request);
        Response.SetValue(Action, _Response);
        tplPath.SetValue(Action, item.tplPath);
        RouteUrl.SetValue(Action, item.RouteUrl);
        MethodName_.SetValue(Action, methodname);
        TableName_.SetValue(Action, item.TableName);

        try
          CreateControllerMethod.Invoke(Action, []); //控制器创建触发动作
        except
          on E: Exception do
          begin
            Log('控制器异常:' + e.Message);
            RouteMap.Error500(_Response);
            exit;
          end;
        end;
        try
          ret_Intercept := Intercept.Invoke(Action, []); //拦截器执行
          InterceptRet := ret_Intercept.AsBoolean;
        except
          on E: Exception do
          begin
            Log('拦截器异常:' + e.Message);
            RouteMap.Error500(_Response);
            exit;
          end;
        end;

        if methodname = '' then
        begin
          if url[url.Length] = '/' then
            url := url + 'index';
          RouteMap.Error404(_Response, url);
          exit;
        end;
        if (item.getMethodType(methodname) <> '') and
          (httpMethod.ToUpper <> item.getMethodType(methodname)) then
        begin
          RouteMap.Error404(_Response, url);
          exit;
        end;
        ActionMethod := item.ActionMethod(methodname);
        if ActionMethod <> nil then
        begin
          try
            aValueArray := RouteMap.GetUrlParams(Action, methodname, url, _Request, _Response, item, ActionMethod);
            if not InterceptRet then
            begin
              try
                {$IFDEF LOGDEBUG}
               // iTickCount := RouteMap.GetTick(Action.ClassName + '.' + methodname, _Request, logmsg);
                {$ENDIF}
                if length(aValueArray) > 0 then
                  resValue := ActionMethod.Invoke(Action, aValueArray)
                else
                  resValue := ActionMethod.Invoke(Action, []);
                if resValue.TypeInfo = nil then
                begin
                  if _Response.ContentType = '' then
                  begin
                    Show.Invoke(Action, [methodname]);
                  end;
                end
                else
                begin
                  typeInfo := resValue.TypeInfo;
                  ValueType := typeInfo.Name;
                  if (resValue.IsObject) then
                  begin
                    var obj := resValue.AsObject;
                    if Assigned(obj) then
                    begin
                      resText := TJson.ObjectToJsonString(obj);
                      obj.free;
                    end;
                  end
                  else if ValueType = 'string' then
                  begin
                    resText := resValue.AsVariant;
                    if ((resText.Substring(0, 1) = '[')
                      or (resText.Substring(0, 1) = '{'))
                      and ((resText.Substring(resText.Length - 1, 1) = ']')
                      or (resText.Substring(resText.Length - 1, 1) = '}')) then
                      _Response.ContentType := 'application/json; charset=' + Config.document_charset
                    else
                      _Response.ContentType := 'text/html; charset=' + Config.document_charset;
                  end
                  else
                  begin
                    if (ValueType = 'IJObject') then
                    begin
                      interface_type := resValue.AsInterface;
                      jo := IJObject(interface_type);
                      resText := jo.toJSON;
                    end
                    else if (ValueType = 'IJArray') then
                    begin
                      interface_type := resValue.AsInterface;
                      ja := IJArray(interface_type);
                      resText := ja.toJSON;
                    end
                    else if (ValueType = 'IDataSet') then
                    begin
                      interface_type := resValue.AsInterface;
                      ds := IDataSet(interface_type);
                      resText := ds.toJSONArray;
                    end
                    else if (ValueType = 'TResData') or (ValueType = 'TRetData') then
                    begin
                      resValue.ExtractRawData(@resdata);
                      resText := '{"code":' + resdata.code.ToString + ', "message":"' + resdata.message + '"}';
                    end;
                    _Response.ContentType := 'application/json; charset=' + Config.document_charset;
                  end;
                  _Response.Content := resText;
                end;
                {$IFDEF LOGDEBUG}

//                logmsg := '关闭mvc.inc文件中的 LOGDEBUG 关闭此调试信息' + #13 + logmsg;
//
//                logmsg := logmsg + #13 + Format('-------------' + Action.ClassName +
//                  '.' + methodname + '(结束)-耗时:  %d 毫秒-----------',
//                  [RouteMap.GetTickCount - iTickCount]);
//
//                Log(logmsg);
                {$ENDIF}
              except
                on e: Exception do
                begin
                  RouteMap.Error500(_Response);
                  Log(e.Message);
                end;
              end;
              _Response.SendResponse;
            end
            else
            begin
              if _Response.StatusCode = 302 then
                _Response.SendResponse
              else
                RouteMap.Error404(_Response, url);
            end;
          except
            on e: Exception do
            begin
              RouteMap.Error500(_Response);
              Log(e.Message);
            end;
          end;
        end
        else
        begin
          if not InterceptRet then
          begin
            len := methodname.Length;
            if (url.Substring(url.Length - len) <> methodname) and (methodname = 'index') then
              url := url + '/' + methodname;
            if not LoadFile(_Response, url) then
              RouteMap.Error404(_Response, url);
          end
          else
          begin
            RouteMap.Error404(_Response, url);
          end;
        end;
      finally
        if Assigned(Action) then
        begin
          RouteMap.FreeValueArray(aValueArray);
          FreeAndNil(Action);
         // Action.Free;
        end;
      end;
    end
    else
    begin
      if not InterceptRet then
      begin
        if not LoadFile(_Response, url) then
          RouteMap.Error404(_Response, url);
      end
      else
      begin
        RouteMap.Error404(_Response, url);
      end;
    end;
  end
  else
  begin
    RouteMap.loadAssets(_Request, _Response, url); //加载资源文件
  end;
end;

procedure TRoute.FreeValueArray(aValueArray: TArray<TValue>);
var
  i: integer;
begin
  for i := 0 to length(aValueArray) - 1 do
  begin
    if aValueArray[i].IsObject then
      aValueArray[i].AsObject.free;
  end;
end;

procedure TRoute.ClearP(ls: TStringList);
var
  k: Integer;
begin
  k := 0;
  while (ls.Count <> k) do
  begin

    if ls[k].trim = '' then
    begin
      ls.Delete(k);
      Continue;
    end;
    k := k + 1;
  end;
end;

constructor TRoute.Create;
begin
  list := TObjectList<TRouteItem>.Create;
  listkey := TStringList.Create;
end;

function TRoute.DateTimeToGMT(const ADate: TDateTime): string;
const
  WEEK: array[1..7] of PChar = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  MonthDig: array[1..12] of PChar = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
var
  wWeek, wYear, wMonth, wDay, wHour, wMin, wSec, wMilliSec: Word;
  sWeek, sMonth: string;
begin
  DecodeDateTime(ADate, wYear, wMonth, wDay, wHour, wMin, wSec, wMilliSec);
  wWeek := DayOfWeek(ADate);
  sWeek := WEEK[wWeek];
  sMonth := MonthDig[wMonth];
  Result := Format('%s, %.2d %s %d %.2d:%.2d:%.2d GMT', [sWeek, wDay, sMonth, wYear, wHour, wMin, wSec]);
end;

destructor TRoute.Destroy;
begin
  listkey.Clear;
  listkey.Free;
  list.Clear;
  list.Free;
end;

procedure TRoute.Error500(Response: TWebResponse; msg: string);
var
  Content, tplFile: string;
  page: Tpage;
begin
  if msg = '' then
    msg := '系统异常,请查看日志';
  Content := '<html><body><div style="text-align: left;">';
  Content := Content + '<div><h1>Error 500</h1></div>';
  Content := Content + '<hr><div>[ ' + msg + ' ]' + '</div></div></body></html>';
  if Config.Error500.Trim <> '' then
  begin
    tplFile := Config.BasePath + config.WebRoot + '\' + Config.Error500 + '.html';
    if FileExists(tplFile) then
    begin
      page := Tpage.Create(tplFile);
      try
        Content := page.Text('<div>[ ' + msg + ' ]' + '</div>');
      finally
        page.Free;
      end;
    end;
  end;
  Response.StatusCode := 500;
  Response.ContentType := 'text/html; charset=' + Config.document_charset;
  Response.Content := Content;
  Response.SendResponse;
end;

procedure TRoute.Error404(Response: TWebResponse; msg: string);
var
  Content, tplFile: string;
  page: Tpage;
begin
  msg := msg.Replace('//', '/');
  Content := '<html><body><div style="text-align: left;">';
  Content := Content + '<div><h1>Error 404</h1></div>';
  Content := Content + '<hr><div>[ ' + msg + ' ] Not Find Page' + '</div></div></body></html>';
  if Config.Error404.Trim <> '' then
  begin
    tplFile := Config.BasePath + config.WebRoot + '\' + Config.Error404 + '.html';
    if FileExists(tplFile) then
    begin
      page := Tpage.Create(tplFile);
      try
        Content := page.Text('<div>[ ' + msg + ' ] Not Find Page' + '</div>');
      finally
        page.Free;
      end;
    end;
  end;
  Response.StatusCode := 404;
  Response.ContentType := 'text/html; charset=' + Config.document_charset;
  Response.Content := Content;
  Response.SendResponse;
end;

function TRoute.finditem(name: string): Boolean;
var
  j: integer;
  key: string;
begin
  Result := false;
  for j := 0 to listkey.Count - 1 do
  begin
    key := listkey.Strings[j];
    if key.ToUpper = name.ToUpper then
    begin
      Result := true;
      break;
    end;
  end;
end;

function TRoute.GetItem(Route: string): TRouteItem;
var
  I, j: Integer;
  item, defitem: TRouteItem;
  key: string;
  isFind: Boolean;
begin
  Result := nil;
  defitem := nil;
  isFind := false;
  for j := 0 to listkey.Count - 1 do
  begin
    key := listkey.Strings[j];
    if (key.ToUpper = LeftStr(Route.ToUpper, key.Length)) or (key.ToUpper = LeftStr(Route.ToUpper + '/', key.Length)) then
    begin
      isFind := true;
      break;
    end;
  end;
  if isFind then
  begin
    for I := 0 to list.Count - 1 do
    begin
      item := list.Items[I];
      if ((key = item.routeUrl) or ((key + '/') = item.routeUrl)) and (item.routeUrl.Length > 1) then
      begin
        Result := item;
        break;
      end
      else if ((key = item.routeUrl) or ((key + '/') = item.routeUrl)) and (item.routeUrl = '/') then
      begin
        defitem := item;
      end;
    end;
  end;
  if Result = nil then
    Result := defitem;
end;

function TRoute.GetRoute(httpMethod: string; url: string; var Route: string; var method: string): TRouteItem;
var
  item: TRouteItem;
  tmp: string;
begin
  item := GetItem(url.Trim);
  if item <> nil then
  begin
    Route := url.ToLower.Trim;
    if Route.StartsWith(item.routeUrl, true) then
      tmp := RightStr(Route, Route.Length - item.routeUrl.Length)
    else
      tmp := '';
    method := item.getMethod(httpMethod, tmp);
  end;
  Result := item;
end;

function TRoute.GetTick(classname: string; _Request: TWebRequest; var msg: string): Cardinal;
var
  mls: TStringList;
begin
  mls := TStringList.Create;
  try
    mls.Add('-------------' + classname + '(开始)------------');
    mls.Add('token：  ' + _Request.Authorization);
    mls.Add('API：    ' + _Request.Method + '  ' + Utf8ToAnsi(AnsiToUtf8(_Request.URL)));
    mls.Add('Query：  ' + Utf8ToAnsi(AnsiToUtf8(_Request.Query)));
//    if _Request.Files.Count > 0 then
//      mls.Add('Content：' + '有' + inttostr(_Request.Files.Count) + '附件')
//    else
//      mls.Add('Content：' + _Request.Content);
//    msg := mls.Text.Trim;
  finally
    mls.Free;
    Result := TThread.GetTickCount;
  end;
end;

function TRoute.GetTickCount: Cardinal;
begin
  Result := TThread.GetTickCount;
end;

function TRoute.StrToParamTypeValue(AValue: string; AParamType: System.TTypeKind): TValue;
begin
  case AParamType of
    System.TTypeKind.tkInteger, System.TTypeKind.tkInt64:
      begin
        try
          if AValue.Trim = '' then
            AValue := '0';
          Result := StrToInt(AValue);
        except
          on e: Exception do
          begin
            Result := 0;
            Log(e.Message);
          end;
        end;
      end;
    System.TTypeKind.tkFloat:
      begin
        try
          if AValue.Trim = '' then
            AValue := '0';
          Result := StrToFloat(AValue);
        except
          on e: Exception do
          begin
            Result := 0;
            Log(e.Message);
          end;
        end;
      end;
    System.TTypeKind.tkString, System.TTypeKind.tkChar, System.TTypeKind.tkWChar, System.TTypeKind.tkLString, System.TTypeKind.tkWString, System.TTypeKind.tkUString, System.TTypeKind.tkVariant:
      begin
        Result := AValue;
      end;
  else
    begin
      Result := AValue;
      //其他类型暂时用不到，先不考虑转换
    end;
//    tkUnknown:;
//    tkEnumeration:;
//    tkSet:;
//    tkClass:;
//    tkMethod:;
//    tkArray:;
//    tkRecord:;
//    tkInterface:;
//    tkDynArray:;
//    tkClassRef:;
//    tkPointer:;
//    tkProcedure:;
//    tkMRecord:;
  end;
end;

function TRoute.GetUrlParams(action: TObject; methodname: string; url: string; Request: TWebRequest; Response: TWebResponse; item: TRouteItem; ActionMethod: TRttiMethod): TArray<TValue>;
var
  //--------大量提供begin------------
  i, k: integer;
  InputToJson, InputJSON: TRttiMethod;
  ActionMethonValue: TRttiParameter;
  ActionMethonValues: TArray<TRttiParameter>;
  aValueArray: TArray<TValue>;
  sParameters: string;
  sValue, s, s1: string;
  params, paramTpl, paramSet: TStringList;
  resValue: TValue;
  isok: boolean;
  //-------大量提供end--------------
begin
  ActionMethonValues := ActionMethod.GetParameters;
  SetLength(aValueArray, Length(ActionMethonValues));
  isok := false;

  for i := Low(ActionMethonValues) to High(ActionMethonValues) do
  begin
    ActionMethonValue := ActionMethonValues[i];
    sParameters := ActionMethonValue.Name;   //参数名
    if (ActionMethonValue.ParamType <> nil) then
    begin

      s1 := ActionMethonValue.ParamType.Name;

      if s1 = 'IJObject' then
      begin
        InputToJson := item.InputToJson;
        resValue := InputToJson.Invoke(action, []);
        aValueArray[i] := resValue;
        isok := true;
      end
      else if 'integer,string'.IndexOf(s1.ToLower) < 0 then
      begin
        InputJSON := item.InputJSON;
        resValue := InputJSON.Invoke(action, []);
        var resText: string := resValue.AsVariant;
        var tt := ActionMethonValue.ParamType;
        var instanceType := TRttiInstanceType(tt);
        var obj := instanceType.MetaclassType.Create;
        var jo := IIJObject(resText);
        TJson.JsonToObject(obj, jo.O);
        aValueArray[i] := obj;
        isok := true;
      end
      else
      begin
        if (Request.QueryFields.Count > 0) then  //从web.GET中提取值
        begin
          sValue := Request.QueryFields.Values[sParameters];
          aValueArray[i] := StrToParamTypeValue(sValue, ActionMethonValue.ParamType.TypeKind); //根据参数数据类型，转换值，只传常量
          isok := true;
        end;
        if (Request.ContentFields.Count > 0) then
        begin
          sValue := Request.ContentFields.Values[sParameters]; //从web.POST中提取值
          aValueArray[i] := StrToParamTypeValue(sValue, ActionMethonValue.ParamType.TypeKind); //根据参数数据类型，转换值，只传常量
          isok := true;
        end;
      end;
    end;
  end;

  if not isok then
  begin
    params := TStringList.Create;
    paramTpl := TStringList.Create;
    paramSet := TStringList.Create;
    try
      s1 := item.routeUrl;
      s := Request.PathInfo;
      if item.MethodPath <> '' then
        s1 := s1 + item.MethodPath;
      if s1.Length < s.Length then
        s := s.Replace(s1, '', [])
      else
        s := '';

      params.Delimiter := '/';
      params.DelimitedText := s;
      ClearP(params);

      s := item.getMethodTpl(methodname);
      s := s.Replace(methodname + '/', '', [rfReplaceAll, rfIgnoreCase]).Replace(':', '', [rfReplaceAll]).Replace(methodname, '', [rfIgnoreCase, rfReplaceAll]);
      paramTpl.Delimiter := '/';
      paramTpl.DelimitedText := s;
      ClearP(paramTpl);
      for i := Low(ActionMethonValues) to High(ActionMethonValues) do
      begin

        if (i < params.Count) then
        begin
          sValue := params.Strings[i];
          if paramTpl.Count > 0 then
            paramSet.Values[paramTpl[i]] := sValue
          else
          begin
            ActionMethonValue := ActionMethonValues[i];
            paramSet.Values[ActionMethonValue.Name] := sValue;
          end;
        end;
      end;
      for i := Low(ActionMethonValues) to High(ActionMethonValues) do
      begin
        ActionMethonValue := ActionMethonValues[i];
        sValue := paramSet.Values[ActionMethonValue.Name];
        aValueArray[i] := StrToParamTypeValue(sValue, ActionMethonValue.ParamType.TypeKind); //根据参数数据类型，转换值，只传常量
      end;
    finally
      paramSet.Clear;
      params.Clear;
      paramTpl.Clear;
      paramSet.Free;
      params.Free;
      paramTpl.Free;
    end;
  end;
  Result := aValueArray;
end;

function TRoute.getMimeType(extension: string): string;
var
  MimeType, key: string;
begin
  Lock(Config.MIME);
  try
    Result := '';
    for key in Config.MIME.Keys do
    begin
      if (Pos(extension, key) > 0) and (Config.MIME.TryGetValue(key, MimeType)) then
      begin
        Result := MimeType + '; charset=' + Config.document_charset;
        Break;
      end;
    end;
  finally
    UnLock(Config.MIME);
  end;
end;

procedure TRoute.loadAssets(_Request: TWebRequest; _Response: TWebResponse; url: string);
var
  tmp, assetsfile, extension, webpath: string;
  assets: TMemoryStream;
  Session: TSession;
  htmlcontent: string;
  pagepars: TTplParser;
  len: integer;
begin
  if (not Config.open_debug) and Config.open_cache then
  begin
    _Response.SetCustomHeader('Cache-Control', 'max-age=' + Config.cache_max_age);
    _Response.SetCustomHeader('Pragma', 'Pragma');
    //TTimeZone.local.ToUniversalTime(now())
    tmp := DateTimeToGMT(now);
    _Response.SetCustomHeader('Last-Modified', tmp);
    tmp := DateTimeToGMT(IncHour(now(), 24));
    _Response.SetCustomHeader('Expires', tmp);
  end
  else
  begin
    _Response.SetCustomHeader('Cache-Control', 'no-cache,no-store');
  end;
  webpath := Config.BasePath;
  assetsfile := webpath + Config.WebRoot + url;
  assetsfile := IITool.PathFmt(assetsfile);
  if FileExists(assetsfile) then
  begin
    len := Config.template_type.Length;
    tmp := assetsfile.Substring(assetsfile.Length - len, len);
    if tmp = config.template_type then
    begin
      Session := TSession.Create(_Request, _Response);
      pagepars := TTplParser.Create;
      try
        htmlcontent := PageCache.LoadPage(assetsfile);
        pagepars.Parser(htmlcontent, nil, '');
      finally
        Session.CreateSessionCookie;
        pagepars.Free;
        Session.Free;
        _Response.ContentType := 'text/html; charset=' + Config.document_charset;
        _Response.Content := htmlcontent;
        _Response.SendResponse;
      end;
    end
    else
    begin
     // tmp:=ExtractFileExt(assetsfile);
      if Pos('?', assetsfile) > 0 then
      begin
        assetsfile := assetsfile.Substring(0, Pos('?', assetsfile));
      end;
      assets := TMemoryStream.Create;
      try
        try
          assets.LoadFromFile(assetsfile);
          extension := ExtractFileExt(assetsfile).Replace('.', '');
          _Response.ContentType := getMimeType(extension);
          if _Response.ContentType <> '' then
          begin
            _Response.SendStream(assets);
          end
          else
          begin
            Error404(_Response, url);
          end;
        except
          on e: Exception do
          begin
            Error404(_Response, url);
            Log(e.Message);
          end;
        end;
      finally
        assets.Free;
      end;
    end;
  end
  else
  begin
    Error404(_Response, url);
  end;
end;

function DescCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := -AnsiCompareText(List[Index1], List[Index2]);
end;

procedure TRoute.SetRoute(routeUrl: string; Action: TClass; tplPath: string;
rqUrl: string; locUrl: string; httpMethod: string; tablename_: string);
var
  item: TRouteItem;
  SrqUrl: string;
begin
  if (locUrl = 'Intercept')
    or (locUrl = 'CreateController')
    or (locUrl = 'InputToJSON')
    or (locUrl = 'InputJSON')
    or (locUrl = 'Show') then
    exit;

  if (routeUrl.Trim <> '') and (routeUrl.Trim <> '/') then
    routeUrl := '/' + routeUrl + '/'
  else
    routeUrl := '/';
  if Config.App.Trim <> '' then
  begin
    routeUrl := '/' + Config.App + routeUrl;
  end;
  routeUrl := routeUrl.Replace('///', '/').Replace('//', '/');

  if not finditem(routeUrl) then
  begin

    item := TRouteItem.Create;
    item.Action := Action;
    item.tplPath := tplPath;
    item.routeUrl := routeUrl;
    item.TableName := tablename_;

    item.ActoinClass := _RTTIContext.GetType(item.Action);
    with item do
    begin
      Show := ActoinClass.GetMethod('Show');
      InputToJson := ActoinClass.GetMethod('InputToJson');
      InputJSON := ActoinClass.GetMethod('InputJSON');
      CreateController := ActoinClass.GetMethod('CreateController');
      Intercept := ActoinClass.GetMethod('Intercept');
      Request := ActoinClass.GetProperty('Request');
      Response := ActoinClass.GetProperty('Response');
      routeUrl_pro := ActoinClass.GetProperty('routeUrl');
      tplPath_pro := ActoinClass.GetProperty('tplPath');
      MethodName_pro := ActoinClass.GetProperty('MethodName');
      TableName_pro := ActoinClass.GetProperty('TableName');
    end;
    List.Add(item);
    listkey.Add(routeUrl);
    listkey.CustomSort(DescCompareStrings);
  end
  else
  begin
    item := GetItem(routeUrl);
    if Pos(':', rqUrl) > 0 then
      SrqUrl := rqUrl.Substring(0, Pos(':', rqUrl) - 2)
    else
      SrqUrl := rqUrl;
    if rqUrl = '' then
      rqUrl := locUrl;
    if locUrl = '' then
      locUrl := rqUrl;
    if SrqUrl = '' then
      SrqUrl := locUrl;
    item.MethodList.Values[SrqUrl] := locUrl;
    item.locMethodList.Values[locUrl] := rqUrl;
    item.HttpMethod.Values[SrqUrl] := httpMethod;
    item.MethodList.Sort;
    item.locMethodList.Sort;
  end;
end;
{ TRouteItem }

function TRouteItem.ActionMethod(methodname: string): TRttiMethod;
var
  methods: TArray<TRttiMethod>;
  m: TRttiMethod;
begin
  Result := nil;
  methods := ActoinClass.GetMethods(methodname);
  for m in methods do
  begin
    begin
      Result := m;
    end;
  end;
end;

constructor TRouteItem.Create();
begin
  MethodList := TStringList.Create;
  locMethodList := TStringList.Create;
  httpMethod := TStringList.Create;
end;

destructor TRouteItem.Destroy;
begin
  httpMethod.Free;
  MethodList.Free;
  locMethodList.Free;
  inherited;
end;

function TRouteItem.getMethod(httpMethod, methodname: string): string;
var
  tmp: string;
  i, k1, k2: integer;
begin
  MethodPath := '';

  if (methodname <> '') then
  begin
    for i := 0 to MethodList.Count - 1 do
    begin
      tmp := MethodList.KeyNames[i];
      k1 := Length(tmp);
      k2 := Length(methodname);
      if k1 <= k2 then
      begin
        if (tmp.ToLower = methodname.Substring(0, k1).ToLower) then
        begin
          if k1 = k2 then
          begin
            MethodPath := tmp;
            Result := MethodList.Values[tmp];
            Exit;
          end
          else if methodname.Substring(k1, 1) = '/' then
          begin
            MethodPath := tmp;
            Result := MethodList.Values[tmp];
            Exit;
          end;
        end;
      end;
    end;
    for i := 0 to locMethodList.Count - 1 do
    begin
      tmp := locMethodList.KeyNames[i];
      k1 := Length(tmp);
      k2 := Length(methodname);
      if k1 <= k2 then
      begin
        if (tmp.ToLower = methodname.Substring(0, k1).ToLower) then
        begin
          if k1 = k2 then
          begin
            MethodPath := tmp;
            Result := locMethodList.Values[tmp];
            Exit;
          end
          else if methodname.Substring(k1, 1) = '/' then
          begin
            MethodPath := tmp;
            Result := locMethodList.Values[tmp];
            Exit;
          end;
        end;
      end;
    end;
  end;

  if ActionMethod(httpMethod) <> nil then
  begin
    Result := httpMethod;
    exit;
  end;
  if (methodname = '') then
  begin
    Result := 'index';
  end
  else
    Result := methodname
end;

function TRouteItem.getMethodTpl(methodname: string): string;
var
  svalue: string;
begin
  Result := '';
  svalue := MethodList.Values[methodname];
  if svalue <> '' then
  begin
    result := locMethodList.Values[svalue];
  end;
end;

function TRouteItem.getMethodType(methodname: string): string;
begin
  result := httpMethod.Values[methodname].ToUpper;
end;

procedure TRouteItem.SetAction(const Value: TClass);
begin
  FAction := Value;
end;

procedure TRouteItem.SetMethodPath(const Value: string);
begin
  FMethodPath := Value;
end;

procedure TRouteItem.SetName(const Value: string);
begin
  FName := Value;
end;

procedure TRouteItem.SetPath(const Value: string);
begin
  FPath := Value;
end;

procedure TRouteItem.SetTableName(const Value: string);
begin
  FTableName := Value;
end;

initialization
  RouteMap := TRoute.Create;

finalization
  RouteMap.Free;

end.

